Aminet 21/Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso/Aminet/comm/mail/TASC.lha/tasc/rexx/TASC.thor

Text File | 1997-06-27 | 10.7 KB | 458 lines

/* $VER: TASC.thor 1.6 (26.06.97)
 *
 *
 * Concept & Original Scripts by: Kirk Strauser <[e-mail]>
 * and Adrian Knight <[e-mail]>
 *
 * Rewritten by: Andy Macklin <[e-mail]>
 */


/* Read the config file & set up defalts if it isn't there */
if open(cfg,'Env:thor/TASC.cfg',r) then do
   do until eof(cfg)
       lin=readln(cfg)
       parse var lin id ':' V
       V=strip(V)
       if upper(left(id,6))='DELMSG' then
          delmsg=V
       if upper(left(id,3))='URG' then
          urg=V
       if upper(left(id,6))='MAILHD' then
          mailhd=V
       if upper(left(id,6))='NEWSHD' then
          newshd=V
       if upper(left(id,6))='GLOBPM' then
          GlobPM=V
       if upper(left(id,10))='POSTMASTER' then
          Postmaster=V
       if upper(left(id,8))='DATABASE' then
          spamdb=V
    end
    call close(cfg)
end
else do
    delmsg='N'
    urg='N'
    mailhd='Email spam'
    newshd='Usenet spam/mail fraud'
    globPM='N'
    Postmaster=''
    spamdb='rexx/spam.db'
end

/*=======================================================*/
/* You're not supposed to change anything from here down */
/*=======================================================*/

Parse ARG CLIARG
CLIARG=upper(CLIARG)
if CLIARG~='AUTO' & CLIARG~='' then do
    say 'Template: Spam-O-Matic.thor AUTO/S'
    say 'Run this script from within Thor'
    exit
end

options results
options failat 31

CDB_MAIL                = 1   /* Private mail conference. */

thorport = address()
if left(thorport, 5) ~= 'THOR.' then do
  say 'Cannot find thorport.'
  exit
end

if ~show('p', 'BBSREAD') then do
  address command
  "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  "WaitForPort BBSREAD"
end

if open(A,'env:thor/thorpath') then do
    THORP=READLN(A)
    call close(A)
end

address(thorport)

CURRENTMSG stem MSG
if (rc ~= 0) then call oops("No current message.")

SAVEMESSAGE CURRENT FILE "T:tasc.tempfile"
if(rc ~= 0) then call oops("Can't save current message.")

IF Open(A,'T:tasc.tempfile','r') = 0 THEN
        call oops("Couldn't open temporary file.")


i='1'
flame.=''
toaddr.=''
do until hder=''
    hder= readln(A)
    if upper(left(hder,8)) = 'RECEIVED' then do
        Call Recd
    end
    if upper(left(hder,7)) = 'MESSAGE' then do
        Call Mess
    end
    if upper(left(hder,6)) = 'RETURN' then do
        Call Rtn
    end
    if upper(left(hder,5)) = 'REPLY' then do
        Call Rply
    end
    if upper(left(hder,5)) = 'FROM:' then do
        Call Frm
    end
    if upper(left(hder,5)) = 'PATH:' then do
        Call Pth
    end
    if upper(left(hder,4)) = 'NNTP' then do
        Call nntp
    end
end
call close(A)
/* Set the values for the Mailserver */
Call Radd
/* Parse out the next level of the internet heirachy to complain to */
Call Boss
/* remove unneeded addresses (if appropriate)*/
if CLIARG~='AUTO' then do
    Call Update
end
/* Check for known bad ISPs, undeliverable addresses or specific addresses for abuse. */
Call Undeliverable

address BBSREAD

READBRMESSAGE bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' msgnr MSG.MSGNR headstem HEADTAGS textstem TEXTTAGS
if (rc ~= 0) then call oops

getconfdata bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' stem CONFDATA
if (rc ~= 0) then call oops

UNIQUEMSGFILE bbsname '"'MSG.BBSNAME'"' stem tmp
if (rc ~= 0) then call oops

/* Build the outgoing message */

if Postmaster~='' then do
    address command
    'echo "From: postmaster@'||Postmaster||'" > t:tasc.tempH'
    'Echo "" >> t:tasc.tempH'
end
if ~bittst(CONFDATA.FLAGS,CDB_MAIL) then do
    address command 'Type "'||THORP||'rexx/SpamNewsHeader" >> T:tasc.tempH'
    end
else do
    address command 'Type "'||THORP||'rexx/SpamMailHeader" >> T:tasc.tempH'
end
address command 'Join t:tasc.tempH t:tasc.tempfile as 'tmp.NAME
if (rc ~= 0) then call oops("Unable to build message file.")

/* Choose the addresses from the header & the hotlist to send the complaint to */
if CLIARG~='AUTO' then do
    Call Chooser
end
else do
    Call AutoR
end

/* Use the appropriate mailer to send it */
call WriteThorMessage

if (rc ~= 0) then call oops

if delmsg='Y' then do
    address(bbsread)
    UPDATEBRMESSAGE '"'MSG.BBSNAME'"' '"'MSG.CONFNAME'"' msgnr MSG.MSGNR SETDELETED
end

call tidy

Recd:
parse VAR hder gubbins 'from ' addss ' by' remains
/* addss should contain the details that we want */
if index(addss,'[')~=0 then do
   parse VAR addss '[' netnum ']' remains
   /* extract the IP number, in case that's all there is*/
end
if index(addss,'(')~=0 then do
   /* Search for brackets containing the details we need */
   parse VAR addss rnme '(' netnum ')' remains
   if index(rnme,'.')=0 then do /* pretty unlikely to be a mailable address */
      if index(netnum,'[')~=0 then do
        parse VAR netnum rnme '[' remains
      end
   end
   if index(netnum,'[')~=0 then do
      /* Parse netnum, one way or the other */
      parse VAR netnum '[' netnum ']' remains
   end
   if index(netnum,'(')~=0 then do
        parse VAR netnum '(' netnum ')' remains
   end
end
if index(netnum,'[')~=0 then do
    parse VAR netnum '[' netnum ']'
end
netnum = '['||strip(netnum)||']'
return

Mess:
/* Message ID may contain a valid _Real_ domain to complain to */
parse VAR hder gubbins '@' mnme '>'
flame.i='Msg-ID:'||strip(mnme)
i=i+1
return

Rtn:
/* Return Path might contain a valid _Real_ domain to complain to */
parse VAR hder gubbins '@' rtnme '>'
flame.i='Return Path:'||strip(rtnme)
i=i+1
return

Rply:
/* Reply-to: might contain a valid _Real_ domain to complain to */
parse VAR hder gubbins '@' rpnme ' ' remains
flame.i='Reply-To:'||strip(rpnme)
i=i+1
return

Frm:
/* From: might contain a valid _Real_ domain to complain to. I wish :( */
parse VAR hder gubbins '@' fnme '>'
flame.i='From:'||strip(fnme)
i=i+1
return

Pth:
/* Search the path: header for possible addresses (news spam only) */
P1=lastpos('!',hder)
P2=lastpos('!',hder,P1-1)
P1=substr(hder,P2+1)
parse VAR P1 parth '!' gubbins
flame.i='Path:'||strip(parth)
i=i+1
return

nntp:
/* Just in case there is an nntp-posting-host header in the news spam */
parse VAR hder gubbins ': ' nntpnme
flame.i='NNTP-Host:'||strip(nntpnme)
i=i+1
return

Radd:
if rnme~='RNME' then do
    flame.i='Mailserver:'||strip(rnme)
    i=i+1
end
if netnum~='NETNUM' then do
    flame.i='Mailserver:'||netnum
    i=i+1
end
return

AutoR:
j=1
toaddr.count=0
do m=1 to (i-1)
    parse VAR flame.m hder ':' tnme
    if bittst(confdata.flags,CDB_Mail) then do
        /* A Mail message */
        if hder='Msg-ID' then do
            call autoadd
            end
        if hder='Mailserver' then do
            call autoadd
            end
        end
    else do
        if hder='NNTP-Host' then do
            call autoadd
            end
        if hder='Path' then do
            call autoadd
            end
    end
end
if toaddr.count=0 then do
    address (thorport)
    requestnotify text '"No addresses suitable for autoreply option"' BT '"_OK"'
    call tidy
end
else do
    drop flame.
    flame.count=toaddr.count
    do i=1 to toaddr.count
        flame.i=toaddr.i
    end
end
return


autoadd:
toaddr.j='auto:'||tnme
j=j+1
toaddr.count=toaddr.count+1
return

Boss:
/* Add the option to complain further up the internet hierachy */
k=i-1
do j=1 to k
    parse VAR flame.j gubbins ':' lwr '.' hghr
    if left(lwr,1)~='[' then do     /*Not an IP number */
        if index(hghr,'.')~=0 then do
            flame.i='Parent of '||gubbins||':'||hghr
            i=i+1
        end
    end
end
return

Update:
m=1
toaddr.count=0
do j=1 to (i-1)
    parse VAR flame.j gubbins ':' jtmp
    uniq=1
    do k=(j+1) to i
        parse VAR flame.k gubbins ':' ktmp
        if jtmp = ktmp then do
            uniq=0
        end
        if jtmp = '' then do
            uniq=0
        end
    end
    if uniq=1 then do
        toaddr.m=flame.j
        toaddr.count=toaddr.count+1
        m=m+1
    end
end
return

Undeliverable:
if open(db,THORP||spamdb,r) then do
    a=0
    wrong.=''
    correct.=''
    do until eof(db)
        lin=readln(db)
        a=a+1
        parse VAR lin wrong.a '->' correct.a
    end
    wrong.count=a
    do m=1 to toaddr.count
        parse VAR toaddr.m nme ':' oldaddr
        do a=1 to wrong.count
            if upper(oldaddr)=upper(wrong.a) then do
                if upper(correct.a)~='UNDELIVERABLE' then do
                    if index(correct.a,'@')~=0 then do
                        toaddr.m='+'||nme||'(Redirected):'||correct.a
                    end
                    else do
                        toaddr.m=nme||'(Redirected):'||correct.a
                    end
                end
                else do
                    toaddr.m='-'||nme||':('||oldaddr||')'||correct.a
                end
            end
        end
    end
end
call close(db)
return

WriteThorMessage:
   address BBSREAD
   EVE_ENTERMSG = 0
   drop EVENT.
   EVENT.TONAME = ''
   Do j=1 to flame.count
       if globPM~='Y' then do
         parse VAR flame.j tnme ':' tadd
         EVENT.TONAME = EVENT.TONAME  || strip(tnme,B,'+') || ','
         end
       else do
         EVENT.TONAME = EVENT.TONAME  || 'Postmaster,'
         end
   end
   EVENT.TONAME = strip(EVENT.TONAME,T,',')
   EVENT.TOADDR = ''
   Do j=1 to flame.count
       parse VAR flame.j tnme ':' tadd
       if left(tnme,1)='+' then
          EVENT.TOADDR = EVENT.TOADDR || tadd|| ','
       else do
          if left(tnme,1)='-' then
            NOP
          else
            EVENT.TOADDR = EVENT.TOADDR || 'postmaster@'|| tadd ||','
       end
   end
   EVENT.TOADDR=strip(EVENT.TOADDR,T,',')
   if ~bittst(CONFDATA.FLAGS,CDB_MAIL) then do
        EVENT.SUBJECT = newshd
        end
   else do
        EVENT.SUBJECT = mailhd
   end
   EVENT.CONFERENCE = 'EMail'
   EVENT.MSGFILE = tmp.FILEPART
   if urg='Y' then do
        EVENT.URGENT = 1
        end
   else do
        EVENT.URGENT=0
   end
   WRITEBREVENT bbsname '"'MSG.BBSNAME'"' event EVE_ENTERMSG stem EVENT
return

Chooser:
/* Here's where the additional recipients like the IRS get added to the options */
DROP flame.
if open(A,THORP||'rexx/spamaddr','r') then do
    DO WHILE ~Eof(A)
        spama=readln(A)
        if left(spama,1)='+' then do
            i=toaddr.count+1
            toaddr.i=spama
            toaddr.count=toaddr.count+1
        end
    END
end
address(Thorport)
Requestlist Instem toaddr outstem flame dragselect multiselect title '"Complain to"'
IF (RC > 0) THEN DO
   REQUESTNOTIFY TEXT '"No Addresses Selected"' BT '"_Ok"'
   address command 'delete >nil: '||tmp.NAME
   call tidy
   EXIT
END
return

oops:
  PARSE ARG errmsg
  if errmsg = '' then do
    if address() = "BBSREAD" then errmsg=BBSREAD.LASTERROR
    else errmsg=THOR.LASTERROR
  end
  address(thorport)
  REQUESTNOTIFY TEXT '"' errmsg '"' BT '"_Abort"'
  call tidy
return


tidy:
  address command 'delete >nil: T:tasc.temp#?'
exit